{This file is part of CheLive.

CheLive is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.

Foobar is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with Foobar.  If not, see <http://www.gnu.org/licenses/>.}

{Реализует работу с шейдерами}
unit CoreShader;

interface

uses
	SysUtils, gl, glext, CoreTypes, CoreMath;

type
	{Uniform-переменная шейдера @seealso(TShader.Uniform)
	@member(id идентификатор)}
	TShaderUni = class(TListItem)
		id: TGLint;
		
		procedure SetInt(i: Integer);
		procedure SetFloat(f: Single);
		procedure SetVec2(v: TVec2); overload;
		procedure SetVec3(v: TVec3); overload;
		procedure SetVec4(v: TVec4); overload;
		procedure SetVec2(v: Pointer; n: Integer); overload;
		procedure SetVec3(v: Pointer; n: Integer); overload;
		procedure SetVec4(v: Pointer; n: Integer); overload;
		
		procedure SetMat4(m: PMat4);
	end;
	
	TShaderUnis = specialize TList<TShaderUni>;
	
	{Шейдер
	@member(fileName имя файла из которого загружен шейдер)
	@member(vert идентификатор вершинного шейдера)
	@member(frag идентификатор фрагментного шейдера)
	@member(prog идентификатор шейдерной программы)
	@member(uniforms массив когда-либо искомых uniform-переменных @seealso(TShader.Uniform))}
	TShader = class(TListItem)
		fileName: String;
		vert, frag, prog: TGLuint;
		uniforms: TShaderUnis;
		
		{Загрузка шейдера из файла
		@param(fileName_ имя файла)
		@returns(True если шейдер загружен, скомпилирован и слинкован)}
		function Load(fileName_: String): Boolean;
		{Включение шейдера}
		procedure Enable;
		{Выключение шейдера}
		class procedure Disable;
		{Получение uniform-переменной
		@param(name_ имя переменной)
		@returns(экземпляр класса TShaderUni для выполения операций над переменной)}
		function Uni(name_: String): TShaderUni;

		constructor Create;
		destructor Destroy; override;
	end;
	
	TShaders = specialize TList<TShader>;
	
	{Менеджер шейдеров}
	TShaderMan = class(TShaders)
		{Добавление шейдера из файла
		@param(fileName имя файла)
		@param(loadAnyway загружать даже если шейдер с таким именем файла уже был загружен,
			иначе если есть шейдер с таким именем файла, то загружаться ничего не будет,
			просто будет возвращен указатель на сущестувющий шейдер)
		@returns(указатель на шейдер если шейдер загружен)}
		function Add(fileName: String; loadAnyway: Boolean = False): TShader;
	end;

var
	sha: TShaderMan;

implementation

uses
	CoreConsole;

procedure TShaderUni.SetInt(i: Integer); begin glUniform1iARB(id, i); end;
procedure TShaderUni.SetFloat(f: Single); begin glUniform1fARB(id, f); end;
procedure TShaderUni.SetVec2(v: TVec2); begin glUniform2fvARB(id, 1, @v); end;
procedure TShaderUni.SetVec3(v: TVec3); begin glUniform3fvARB(id, 1, @v); end;
procedure TShaderUni.SetVec4(v: TVec4); begin glUniform4fvARB(id, 1, @v); end;
procedure TShaderUni.SetVec2(v: Pointer; n: Integer); begin glUniform2fvARB(id, n, v); end;
procedure TShaderUni.SetVec3(v: Pointer; n: Integer); begin glUniform3fvARB(id, n, v); end;
procedure TShaderUni.SetVec4(v: Pointer; n: Integer); begin glUniform4fvARB(id, n, v); end;
procedure TShaderUni.SetMat4(m: PMat4); begin glUniformMatrix4fvARB(id, 1, GL_FALSE, @m^.m11); end;

constructor TShader.Create;
begin
	vert := 0;
	frag := 0;
	prog := 0;
	uniforms := TShaderUnis.Create;
end;

destructor TShader.Destroy;
begin
	if prog <> 0 then
	begin
		if frag <> 0 then glDetachObjectARB(prog, frag);
		if vert <> 0 then glDetachObjectARB(prog, vert);

		glDeleteObjectARB(prog);
	end;

	if frag <> 0 then glDeleteObjectARB(frag);
	if vert <> 0 then glDeleteObjectARB(vert);
	
	FreeAndNil(uniforms);
end;

function ShaderCompiled(obj: TGLhandleARB): Boolean;
var
	i, j: Integer;
	s: String;
begin
	Result := False;

	glGetObjectParameterivARB(obj, GL_OBJECT_COMPILE_STATUS_ARB, @i);

	if i = GL_FALSE then
	begin
		glGetObjectParameterivARB(obj, GL_OBJECT_INFO_LOG_LENGTH_ARB, @i);

		if i > 0 then
		begin
			SetLength(s, i);
			glGetInfoLogARB(obj, i, @j, @s[1]);
			SetLength(s, i - 2);
			con.Msg(StringReplace(s, #10, #13, [rfReplaceAll, rfIgnoreCase]));
		end;

		Exit;
	end;

	Result := True;
end;

function TShader.Load(fileName_: String): Boolean;
var
	f: Text;
	s, s2: String;
	pv, pf: Integer;
	sv, sf: PChar;
begin
	Result := False;
	
	{$I-}
	AssignFile(f, fileName_);
	Reset(f);
	{$I+}

	if IOResult <> 0 then
	begin
		con.Msg('#Не удается открыть файл шейдера "%s"', [fileName_]);
		Exit;
	end;

	s := '';

	while not EOF(f) do
	begin
		Readln(f, s2);
		s := s + s2 + #13;
	end;

	CloseFile(f);
	
	if (Pos('[vert]', s) = 0) and (Pos('[frag]', s) = 0) then
	begin
		con.Msg('#В файле "%s" отсутствуют метки ("[vert]" и/или "[frag]")', [fileName_]);
		Exit;
	end;
	
	pv := Pos('[vert]', s);
	pf := Pos('[frag]', s);
	
	if pv <> 0 then
	begin
		if pf <> 0 then
		begin
			sv := PChar(Copy(s, pv + 6, pf - pv - 6));
		end else
		begin
			sv := PChar(Copy(s, pv + 6, Length(s) - pv + 1));
		end;
		
		vert := glCreateShaderObjectARB(GL_VERTEX_SHADER_ARB);
		
		glShaderSourceARB(vert, 1, @sv, nil);
		glCompileShaderARB(vert);
		
		if not ShaderCompiled(vert) then
		begin
			con.Msg('#Не удается скомпилировать шейдер "%s"', [fileName_]);
			Exit;
		end;
	end;
	
	if pf <> 0 then
	begin
		sf := PChar(Copy(s, pf + 6, Length(s) - pf + 1));
		
		frag := glCreateShaderObjectARB(GL_FRAGMENT_SHADER_ARB);
		
		glShaderSourceARB(frag, 1, @sf, nil);
		glCompileShaderARB(frag);
		
		if not ShaderCompiled(frag) then
		begin
			con.Msg('#Не удается скомпилировать шейдер "%s"', [fileName_]);
			Exit;
		end;
	end;
	
	prog := glCreateProgramObjectARB();

	glAttachObjectARB(prog, vert);
	glAttachObjectARB(prog, frag);
	glLinkProgramARB(prog);
	
	fileName := fileName_;
	
	con.Msg('Шейдер "%s" загружен успешно', [fileName]);
	
	Result := True;
end;

procedure TShader.Enable;
begin
	glUseProgramObjectARB(prog);
end;

class procedure TShader.Disable;
begin
	glUseProgramObjectARB(0);
end;

function TShader.Uni(name_: String): TShaderUni;
begin
	Result := uniforms.Find(name_);

	if Result <> nil then
	begin
		Exit;
	end;

	Result := TShaderUni.Create;
	Result.name := name_;
	Result.id := glGetUniformLocationARB(prog, PChar(name_));

	uniforms.Add(Result);
end;

function TShaderMan.Add(fileName: String; loadAnyway: Boolean = False): TShader;
var
	i: Integer;
begin
	Result := nil;	
	
	if not loadAnyway then
	begin
		for i := 0 to size - 1 do
		begin
			if (items[i] <> nil) and (items[i].fileName = fileName) then
			begin
				Result := items[i];
				Break;
			end;
		end;
		
		if Result <> nil then
		begin
			Exit;
		end;
	end;
	
	Result := TShader.Create;
	
	if not Result.Load(fileName) then
	begin
		Result.Free;
		Result := nil;
		Exit;
	end;
	
	inherited Add(Result);
end;

end.

